perm filename A[NEW,LCS] blob sn#519455 filedate 1980-07-01 generic text, type T, neo UTF8
C**SUBRS.  SLUR, (JUGGLE), (LOOP), (PLTSRT), (LINES), (HOMER),
C  SCL,(FORMAT), IBLANK, BMX, ACSHFT, SETUP, TYPE, SETLET, BEAMX

	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	COMMON/SLR/ SLURX(32)
	REAL CENTR
	COMMON /XRN/RN(1) /PLTR/PLT,RHT,RDIS 
	COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
	1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
	1 J5,J6,J7,J8,J9,J10,J11,JQ(8),RJ
	COMMON/PTR/PWDS(1) /STF/RSTFAC(0/7),RSTJ2 
	1 /LIMIT/LIMIT,ITEM,L,I,IX /ALF/INP,SLURY(72) 
CC	DATA RSLUR/22.0/
CF	DATA RZZ/2.8/
C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8	

CCC	IF(JA.NE.12)GO TO 2
CF	RA=5.96*RSTJ2*R5
CF	L=3
CF	J8=J8*RDIS
CF	IF(J7.LE.J6)J7=J7+360
CF	KQ=6
CF	IF(PLT)KQ=1
CF10	DO 3 K=J6,J7,KQ
CF	R=K
CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
CF3	L=2
CF	J8=J8-1
CF	IF(J8)RETURN
CF	RA=RA+1/RDIS
CF	L=3
CF	GO TO 10
CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
CCC	CALL CIRCLE
CCC	RETURN

C*** SLURS *** 5, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
C  P9=NUM IN BRACKET(IF NON-ZERO)
2	IF(J8.GE.7)CALL BRKSLR
C J8=7=SLUR WITH VERT. BRKTS.  =8=BRKT ON LEFT ONLY. =9=ON RIGHT ONLY.
	J10=1
	J4=-1
	J5=1
C  ↑↑↑↑ FOR DPY ONLY (32 SEGS ARE USED)
	TWICE=-1
	IF(R3.GT.-1000)GO TO 2100
	R=-R3-1000
	L=R
	R=-(R3+1000+R)
	R3=RN(PWDS(L)+4)+R
2100	IF(R6.GT.-1000)GO TO 21  
	R=-R6-1000
	L=R
	R=-(R6+1000+R)
	R6=RN(PWDS(L)+4)+R
COCT	IF(R6)R6=202
C  R6=NEG. IS FOR PAGE-LAYOUT PROG. TELLS WHICH NOTE TO SLUR TO.
21	RST7=RSTJ2*7.
	RJ=ABS(R7)
C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
	IF(RJ.LT.100)RJ=-1
	R7=AMOD(R7,100.0)
	IF(RJ.LT.300)GO TO 20
	RJ=0
CC*** NOT YET!	R5=R5-(2*R7)
C R5 THINKS THE SLUR ISN'T REVERSED.
C TO USE THIS ADD R6=SQRT((R5-R4)**2+(R6-R3)**2)+R3(WITH FACTORS)
20	RQQ=R5-R4
	IF(R6.GT.1000)CALL RNOTE(R6)
	GO TO (5,6,7),J8+4
	GO TO 4
CC5	R=32
5	R=30
C AFTER DOTTED NOTE
	GO TO 8
6	R=22
CC6	R=RSLUR
C BETWEEN NOTES
CC8	RX=-1.3
8	RX=-0.75
	GO TO 9
7	R=7
	RX=RSTJ2
9	CALL RJBX(R)
	R6=R6+RX
4	RXX=RHORZ(R6)-R3
	RTILT=RQQ*RST7
80	RX=SQRT(RXX**2+RTILT**2)
	IF(J8.NE.-1)GO TO 1
	IF(RQQ.GT.8)RQQ=8
	IF(RQQ.LT.-8)RQQ=-8
	RQQ=RQQ*RSTFAC(J2)*1.0
	IF(R7)RQQ=-RQQ
	R3=R3-RQQ
C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
1	R=CENTR
	IF(J8.GT.0)GO TO 180
C  JUMP FOR BRACKETS
	L=32
	CALL SLOOP

CF	RB=RX/71.
CF	DO 81 K=0,71
CF81	SLURX(K+1)=RB*(K)+R3
CF	RA=R7*RST7
CF41	IF(R9.EQ.0)R9=RZZ
CF	R=R+RA
CF	L=0
CF	DO 40 K=36,1,-1
CF	L=L+1
CF	RW=R-RA*(K/36.)**R9
CF	SLURY(L)=RW
CF40	SLURY(73-L)=RW
CF	L=72

CF89	IF(RTILT.EQ.0)GO TO 87
CF	RW=ATAN2(RTILT,RXX)
CF	RA=SIN(RW)
CF	RB=COS(RW)
CF	RZ=SLURX(1)
CF	RW=SLURY(1)
CF	DO 83 K=1,L
CF	R=SLURX(K)-RZ
CF	RXX=SLURY(K)-RW
CF	SLURX(K)=RB*R-RA*RXX+RZ
CF83	SLURY(K)=RB*RXX+RA*R+RW

87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
	J6=J10
	J7=L
	IF(J4.NE.0)GO TO 22
	CALL EXCH(J6,J7)
	J5=-1

22	IF(J11.NE.0)J11=3
	CALL SLRS